home *** CD-ROM | disk | FTP | other *** search
/ Giga Games 1 / Giga Games.iso / net / usenet / vmsnet / snake / part01 next >
Encoding:
Internet Message Format  |  1992-02-26  |  37.9 KB
  1. Path: uunet!wupost!waikato.ac.nz!ccc_rex
  2. From: ccc_rex@waikato.ac.nz
  3. Newsgroups: vmsnet.sources.games
  4. Subject: SNAKE 1/2
  5. Message-ID: <1992Feb27.143314.6695@waikato.ac.nz>
  6. Date: 27 Feb 92 14:33:14 +1300
  7. Organization: University of Waikato, Hamilton, New Zealand
  8. Lines: 1250
  9.  
  10. Here is the multi-player SNAKE game in two parts.
  11. Restriction:  All players must be on the same VAX and be in the same
  12.               UIC group.  It uses VT52 escape sequences.
  13.  
  14.             - Rex Croft
  15.  
  16. $! ------------------ CUT HERE -----------------------
  17. $ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
  18. $!
  19. $! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
  20. $!   On 27-FEB-1992 14:28:57.73   By user CCC_REX 
  21. $!
  22. $! This VMS_SHARE Written by:
  23. $!    Andy Harper, Kings College London UK
  24. $!
  25. $! Acknowledgements to:
  26. $!    James Gray       - Original VMS_SHARE
  27. $!    Michael Bednarek - Original Concept and implementation
  28. $!
  29. $!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
  30. $!  BELOW 80 BLOCKS
  31. $!
  32. $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
  33. $! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
  34. $!
  35. $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
  36. $!       1. SNAKE.COM;2
  37. $!       2. SNAKE.MAR;27
  38. $!       3. SNAKE.SCN;9
  39. $!       4. SNAKEH.FOR;2
  40. $!       5. SNAKEP.PAS;4
  41. $!
  42. $set="set"
  43. $set symbol/scope=(nolocal,noglobal)
  44. $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
  45. $e="write sys$error  ""%UNPACK"", "
  46. $w="write sys$output ""%UNPACK"", "
  47. $ if f$trnlnm("SHARE_LOG") then $ w = "!"
  48. $ ve=f$getsyi("version")
  49. $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
  50. $ e "-E-OLDVER, Must run at least VMS 4.4"
  51. $ v=f$verify(v)
  52. $ exit 44
  53. $UNPACK: SUBROUTINE ! P1=filename, P2=checksum
  54. $ if f$search(P1) .eqs. "" then $ goto file_absent
  55. $ e "-W-EXISTS, File ''P1' exists. Skipped."
  56. $ delete 'f'*
  57. $ exit
  58. $file_absent:
  59. $ if f$parse(P1) .nes. "" then $ goto dirok
  60. $ dn=f$parse(P1,,,"DIRECTORY")
  61. $ w "-I-CREDIR, Creating directory ''dn'."
  62. $ create/dir 'dn'
  63. $ if $status then $ goto dirok
  64. $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
  65. $ delete 'f'*
  66. $ exit
  67. $dirok:
  68. $ w "-I-PROCESS, Processing file ''P1'."
  69. $ if .not. f$verify() then $ define/user sys$output nl:
  70. $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
  71. PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
  72. SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
  73. CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
  74. LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
  75. BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
  76. IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
  77. MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
  78. ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
  79. 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
  80. POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
  81. ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
  82. COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
  83. "output_file"));ENDPROCEDURE;Unpacker;QUIT;
  84. $ delete/nolog 'f'*
  85. $ CHECKSUM 'P1'
  86. $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
  87. $ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
  88. $ ENDSUBROUTINE
  89. $START:
  90. $ create 'f'
  91. X$ MACRO snake
  92. X$ PASCAL snakep
  93. X$ FORTRAN snakeh
  94. X$!
  95. X$ LINK /NODEB/NOTRACE /EXE=snake  snakep,snake,snakeh, util/LIB
  96. X$!
  97. $ CALL UNPACK SNAKE.COM;2 556996453
  98. $ create 'f'
  99. X`09.title`09SNAKEM`09Snake Game
  100. X;+
  101. X;`09or`09TANKM`09Tank Game
  102. X;`09if $$TANK is defined
  103. X;-
  104. X
  105. X`09$dibdef
  106. X`09$iodef
  107. X`09$qiodef
  108. X`09$secdef
  109. X`09$jpidef
  110. X;`09$ssdef
  111. Xesc`09`09= 27
  112. X
  113. Xsnake`09`09= 8`09`09; number of snakes
  114. X
  115. X;`09meaning of event flags in cluster 2
  116. X
  117. Xflag$v_master`09= 0`09`09; set if a master snake exists
  118. Xflag$v_read`09= 1`09`09; set if all snakes should read command
  119. Xflag$v_update`09= 2`09`09; set if all snakes should update screen
  120. Xflag$v_game`09= 3`09`09; set if game is in progress
  121. Xflag$v_endofgame= 4`09`09; set if we have reached the end of the game
  122. Xflag$v_synch`09= 5
  123. Xflag$v_done`09= 8`09`09; set if operation (read,update) is complete
  124. X
  125. Xcheck_timer`09= 13`09`09; check timer id
  126. X
  127. X
  128. X`09.psect`09$rodata`09nowrt, noexe, shr, pic, long
  129. X
  130. Xttname_descr:
  131. X`09.ascid`09/TT/
  132. X
  133. Xmbxcnv:
  134. X`09.ascid`09/_MBA!UW:/`09; convert mbx unit number to physical name
  135. X
  136. Xmbxbuf_descr:
  137. X`09.word`09mbxbuf_siz, 0
  138. X`09.long`09mbxbuf
  139. X
  140. Xdibbuf_descr:
  141. X`09.word`09dib$k_length, 0
  142. X`09.long`09dibbuf
  143. X
  144. X`09.align long
  145. Xsnake_desc_2:
  146. X.if ndf $$tank
  147. X`09.ascid`09/SNAKE_1/`09`09; name of snake event flags
  148. X.iff
  149. X`09.ascid`09/TANK_1/
  150. X.endc
  151. X
  152. X`09.align`09long
  153. Xsnake_map_name:
  154. X.if ndf $$tank
  155. X`09.ascid`09/SNAKE_DATA/
  156. X.iff
  157. X`09.ascid`09/TANK_DATA/
  158. X.endc
  159. X
  160. Xtext = .
  161. X`09.ascii`09<esc>'<'`09`09; enter ANSI mode
  162. X`09.ascii`09<esc>'(B'`09`09; select ascii character set
  163. X`09.ascii`09<esc>'`5B2J'`09`09; erase entire screen
  164. X`09.ascii`09<esc>'`5B1;1H'`09`09; jump to top left corner
  165. X`09.ascii`09<10>`09`09`09; linefeed
  166. X.if ndf $$tank
  167. X`09.ascii`09<esc>'#3                 SNAKE' ; double-height top half
  168. X.iff
  169. X`09.ascii`09<esc>'#3                 TANK'
  170. X.endc
  171. X`09.ascii`09<13><10>
  172. X.if ndf $$tank
  173. X`09.ascii`09<esc>'#4                 SNAKE' ; double-height bottom half
  174. X.iff
  175. X`09.ascii`09<esc>'#4                 TANK'
  176. X.endc
  177. X`09.ascii`09<13><10><10>
  178. X`09.ascii`09<esc>'#6        Thank you for playing'
  179. X`09.ascii`09<13><10><10>
  180. Xtext_len = . - text
  181. X`09.align`09long
  182. Xtext_end_game:
  183. X`09.long`092
  184. X`09.long`09text
  185. X`09.address 10$
  186. X10$:`09.long`09text_len
  187. X
  188. Xtext = .
  189. X`09.ascii`09<13><10><10>
  190. X`09.ascii`09'Game aborted because master '
  191. X.if ndf $$tank
  192. X`09.ascii`09'snake'
  193. X.iff
  194. X`09.ascii`09'tank'
  195. X.endc
  196. X`09.ascii`09' quitted'<13><10><10>
  197. Xtext_len = . - text
  198. X`09.align`09long
  199. Xtext_abort:
  200. X`09.long`092
  201. X`09.long`09text
  202. X`09.address 10$
  203. X10$:`09.long`09text_len
  204. X
  205. Xtext = .
  206. X`09.ascii`09<esc> 'Y' <31+24> <31+1>`09; col 1, row 24
  207. X`09.ascii`09<esc> 'G'`09`09`09; exit graphics
  208. X`09.ascii`09<7> ' Please wait for next game ...'
  209. X`09.ascii`09<esc> 'F'`09`09`09; enter graphics
  210. Xtext_len = . - text
  211. X`09.align`09long
  212. Xtext_wait:
  213. X`09.long`092
  214. X`09.long`09text
  215. X`09.address 10$
  216. X10$:`09.long`09text_len
  217. X
  218. X`09.align`09long
  219. Xusername_jpi:
  220. X`09.word`0912, jpi$_username
  221. X`09.address username_buf
  222. X`09.address username_siz
  223. X`09.long`090
  224. X
  225. X`09.align`09long
  226. Xstart_wait:
  227. X`09.long`09-10000000*5, -1`09`09; wait 5 seconds
  228. Xsecond_1:
  229. X`09.long`09-10000000*1, -1`09`09; wait 1 second
  230. Xsecond_2:
  231. X`09.long`09-10000000*2, -1`09`09; wait 2 seconds
  232. Xupdate_wait:
  233. X`09.long`09-100000*33, -1`09`09; wait 33/100 ths of a second
  234. Xcheck_wait:
  235. X`09.long`09-10000000*4, -1`09`09; wait 2 seconds for checking
  236. Xvalid_move:
  237. X`09.long`09`5EB101110100`09`09; valid moves are 2,4,6,8 and 5!!
  238. Xstart_direction:
  239. X.if ndf $$tank
  240. X`09.byte`092, 8, 2, 8, 2, 8, 6, 4`09; initial move directions for snake
  241. X.iff
  242. X`09.byte`096, 4, 4, 6, 2, 8, 6, 4`09;  for tank
  243. X.endc
  244. X`09.align`09long
  245. Xadd_head_par:
  246. X`09.long`091`09`09`09; parameter list to Pascal routine
  247. X`09.address move`09`09`09; each players move
  248. Xupdate_par:
  249. X`09.long`092
  250. X`09.address outbuf
  251. X`09.address screen_len
  252. Xupdate_par2:`09`09`09; if we have died, then there is no head
  253. X`09.long`092`09`09; to change to a diamond, so write screen
  254. X`09.address screen_buf`09; update directly from global memory.
  255. X`09.address screen_len
  256. X
  257. X`09.psect`09$rwbuf`09wrt, noexe, noshr, pic, page
  258. X
  259. Xmbxname_len = 16
  260. Xmbxname:`09`09`09; room to hold the physical mbx name
  261. X`09.blkb`09mbxname_len
  262. Xmbxname_descr:
  263. X`09.word`09mbxname_len, 0
  264. X`09.long`09mbxname
  265. Xmbxiosb:
  266. X`09.long`090,0
  267. Xmbxbuf_siz = 32
  268. Xmbxbuf:
  269. X`09.blkb`09mbxbuf_siz
  270. X
  271. Xdibbuf:
  272. X`09.blkb`09dib$k_length
  273. X
  274. X`09.align`09long
  275. Xttiosb:
  276. X`09.long`090,0
  277. X
  278. Xttbuf_siz = 128
  279. Xttbuf:
  280. X`09.blkb`09ttbuf_siz
  281. X`09.align`09page
  282. Xoutbuf_siz = 512
  283. Xoutbuf::
  284. X`09.blkb`09outbuf_siz
  285. X
  286. X
  287. X;snake_fab:
  288. X;.if ndf $$tank
  289. X;`09$fab`09fnm=<GAMES:SNAKE.BIN>, fop=<ufo>,-
  290. X;`09`09fac=<get,put>, shr=<get,upd,upi>
  291. X;.iff
  292. X;`09$fab`09fnm=<GAMES:TANK.BIN>, fop=<ufo>,-
  293. X;`09`09fac=<get,put>, shr=<get,upd,upi>
  294. X;.endc
  295. Xmap_range:
  296. X`09.address share_data
  297. X`09.address share_data+<512*3>
  298. Xret_range:
  299. X`09.long`090, 0
  300. X
  301. X
  302. X`09.psect`09$sharedata wrt, noexe, shr, pic, page
  303. Xshare_data:
  304. X
  305. Xgame_count:
  306. X`09.long`09`09`09; count of number of games played
  307. Xmaster_flag:
  308. X`09.long`09`09`09; = 1 if we are master snake
  309. Xabort:
  310. X`09.long`09`09`09; = 1 if all snakes should abort
  311. Xplayer_bits:
  312. X`09.long`09`09`09; bit set if that snake is playing
  313. Xplayers:
  314. X`09.long`09`09`09; bit set if that snake is reserved
  315. Xother_players:
  316. X`09.long`09`09`09; used by master snake to wait for other
  317. X`09`09`09`09; snakes to indicate operation completed
  318. Xmove_count:
  319. X`09.long`09`09`09; incremented every move.  Used for detecting
  320. X`09`09`09`09; other snakes hanging the game
  321. Xgame_going:
  322. X`09.long`09`09`09; <> 0 if a game is going
  323. Xyou_just_died:
  324. X`09.long`09`09`09; bit I set if snake I just died
  325. Xseed:
  326. X`09.long`09`09`09; random number seed
  327. Xstart_position:
  328. X`09.blkl`09snake`09`09; position of starting (1-8)
  329. X;
  330. X;`09`095
  331. X;    1`09+---------------+  3
  332. X;`09`7C`09`09`7C
  333. X;`09`7C`09`09`7C
  334. X;    7`09`7C`09`09`7C  8
  335. X;`09`7C`09`09`7C
  336. X;`09`7C`09`09`7C
  337. X;    4`09+---------------+  2
  338. X;`09`096
  339. X;
  340. Xscore:
  341. X`09.blkl`09snake`09`09; players' score
  342. Xn_games:
  343. X`09.blkl`09snake`09`09; # of games each player has played
  344. Xwins:
  345. X`09.blkl`09snake`09`09; # of wins for each player
  346. Xplayer_pos:
  347. X`09.blkl`09snake`09`09; starting position of each snake
  348. X`09.align`09quad
  349. Xmove:
  350. X`09.blkb`09snake`09`09; each snakes move
  351. Xname_size = 32
  352. Xname:
  353. X`09.blkb`09name_size * snake ; each snakes name (32 chars long)
  354. X. = . + 512 - < . - share_data >
  355. X`09.align`09long
  356. Xscreen_len:
  357. X`09.long`09`09`09; # chars to be output
  358. Xscreen_buf:
  359. X`09.blkb`09508`09`09; buffer containing screen update
  360. X. = . + <512*4> - < . - share_data >
  361. X
  362. X
  363. X`09.psect`09$rwdata`09wrt, noexe, noshr, pic, long
  364. X
  365. Xttchan:
  366. X`09.word
  367. Xmbxchan:
  368. X`09.word
  369. Xdata_ready:
  370. X`09.word
  371. Xmaster:
  372. X`09.word`09`09`09; = 1 if we are master snake
  373. Xcontrol_c_flag:
  374. X`09.word`09`09`09; non zero if `5EC typed
  375. Xdead:
  376. X`09.word`09`09`09; bit I set if snake I just died
  377. X`09.align`09long
  378. Xcluster_2:
  379. X`09.long
  380. Xcluster_3:
  381. X`09.long
  382. Xplayer:
  383. X`09.long
  384. Xplayer_efn:`09`09`09; my player efn in cluster 2
  385. X`09.long
  386. Xcurrent_players:
  387. X`09.long
  388. Xchars_left:`09`09`09; # of chars left in buffer
  389. X`09.long
  390. Xchar_pointer:
  391. X`09.long`09`09`09; address of next character
  392. Xlast_move_count:
  393. X`09.long
  394. Xusername_buf:
  395. X`09.blkb`0912
  396. Xusername_siz:
  397. X`09.long
  398. X
  399. Xoutbuf_qio:
  400. X`09$qio`09func=io$_writevblk!io$m_noformat,-
  401. X`09`09p1=outbuf
  402. Xoutput_qio:
  403. X`09$qio`09func=io$_writevblk!io$m_noformat
  404. X
  405. Xread_qio:
  406. X`09$qio`09func=io$_readvblk!io$m_timed!io$m_noecho!io$m_nofiltr,-
  407. X`09`09iosb=ttiosb,-
  408. X`09`09p1=ttbuf, p2=ttbuf_siz, p3=0`09; wait time = 0
  409. X
  410. Xexit_block:`09`09`09; exit handler block
  411. X`09.long
  412. X`09.address snake_exit
  413. X`09.long`091`09`09; 1 argument
  414. X`09.address 10$
  415. X10$:`09.long`09`09`09; exit reason
  416. X
  417. X
  418. X`09.psect`09$code`09nowrt, exe, shr, pic
  419. X
  420. X`09.entry`09-
  421. XTTINIT, `5Em<>
  422. X;+
  423. X; Create a mailbox.  Assign a channel to terminal with an associated mailbox
  424. V.
  425. X;-
  426. X`09$crembx_s`09chan=mbxchan, promsk=#`5ExFF00
  427. X`09bsbw`09`09error
  428. X`09$getchn_s`09chan=mbxchan, pribuf=dibbuf_descr
  429. X`09bsbw`09`09error
  430. X`09$fao_s`09`09ctrstr=mbxcnv, outbuf=mbxname_descr,-
  431. X`09`09`09outlen=mbxname_descr, p1=dibbuf+dib$w_unit
  432. X`09$assign_s`09devnam=ttname_descr, chan=ttchan, acmode=#`5ExFF00,-
  433. X`09`09`09mbxnam=mbxname_descr
  434. X`09blbc`09r0, 100$
  435. X`09movw`09ttchan, outbuf_qio+qio$_chan`09`09;store channel #
  436. X`09movw`09ttchan, output_qio+qio$_chan`09`09;store channel #
  437. X`09movw`09ttchan, read_qio+qio$_chan`09`09;store channel #
  438. X`09$qiow_s`09func=#io$_setmode!io$m_ctrlcast, chan=ttchan,-
  439. X`09`09p1=control_c
  440. X`09ret
  441. X100$:
  442. X`09bsbw`09error
  443. X`09ret
  444. X
  445. X`09.entry`09-
  446. XTT1CHAR,`09`5Em<>
  447. X`09clrb`09ttbuf
  448. X`09$qiow_s`09func=#io$_readvblk!io$m_timed!io$m_noecho!io$m_nofiltr,-
  449. X`09`09chan=ttchan, iosb=ttiosb,-
  450. X`09`09p1=ttbuf, p2=#1, p3=#0`09; wait time = 0
  451. X`09cvtbl`09ttbuf, r0
  452. X`09cmpb`09r0, #13`09`09`09; is it <CR> ?
  453. X`09bneq`09100$
  454. X`09clrb`09data_ready
  455. X100$:`09ret
  456. X
  457. XTTREAD::
  458. X`09blbs`09control_c_flag, 10$
  459. X`09tstl`09chars_left`09`09; have we used all characters ?
  460. X`09bgtr`0950$`09`09`09; no --> 50$
  461. X`09bbsc`09#0, data_ready, 20$`09; check if input ready
  462. X5$:`09mnegl`09#1, r0`09`09`09; no characters read
  463. X`09rsb`09`09`09`09; no
  464. X10$:
  465. X`09clrl`09r0`09`09`09; on `5EC return move 0 = quit
  466. X`09rsb
  467. X20$:
  468. X`09$qiow_g read_qio
  469. X`09blbc`09r0, 5$`09`09`09; error
  470. X;
  471. X;`09$qiow_s`09func=#io$_writevblk,chan=ttchan,-`09; debug write
  472. X;`09`09p1=ttbuf, p2=ttiosb+2, p4=#`5Ex1000
  473. X
  474. X`09movzwl`09ttiosb+2, chars_left`09`09; # chars read
  475. X`09movab`09ttbuf, char_pointer`09`09; store address of character
  476. X50$:
  477. X`09decl`09chars_left
  478. X`09movzbl`09@char_pointer, r0`09`09; get next char
  479. X`09incl`09char_pointer`09`09`09; point to next
  480. X`09subb2`09#`5EA/0/, r0`09`09`09; convert from ascii to binary
  481. X`09blss`09200$`09`09`09`09; invalid command
  482. X`09cmpb`09r0, #9
  483. X`09bgeq`09150$`09`09`09`09; invalid command (maybe quit)
  484. X`09bbc`09r0, valid_move, 200$`09`09; invalid command
  485. X.if df $$tank
  486. X`09tstl`09chars_left`09`09`09; any chars left ?
  487. X`09bleq`09100$`09`09`09`09; no --> 100$
  488. X`09cmpb`09@char_pointer, #`5EA/5/`09`09; is next command fire ?
  489. X`09bneq`09100$`09`09`09`09; no --> 100$
  490. X`09incl`09char_pointer
  491. X`09decl`09chars_left
  492. X`09bisb2`09#`5EB10000, r0`09`09`09; add 16 to indicate fire
  493. X.endc
  494. X100$:
  495. X`09rsb
  496. X150$:
  497. X`09cmpb`09r0, #`5EA/e/-`5EA/0/`09`09; was an "e" typed ?
  498. X`09beql`09180$
  499. X`09cmpb`09r0, #`5EA/E/-`5EA/0/`09`09; was an "E" type ?
  500. X`09bneq`09200$
  501. X180$:
  502. X`09clrl`09r0`09`09`09`09; quit is move = 0
  503. X`09rsb
  504. X200$:
  505. X`09mnegl`09#1, r0`09`09`09`09; no move given
  506. X`09rsb
  507. X
  508. X`09.entry`09-
  509. XMBXREAD,`09`5Em<>
  510. X;+
  511. X; This is an AST routine which executes when the mailbox record has been rea
  512. Vd.
  513. X; The record itself is a status message which is assumed to say that
  514. X; unsolicited data is available at the terminal
  515. X;-
  516. X`09blbc`09mbxiosb, 100$`09`09; on error, dont re-que read
  517. X;`09we could have SS$_CANCEL or SS$_ABORT from the $CANCEL in the
  518. X;`09exit handler
  519. X`09movb`09#1, data_ready`09`09; indicate data is there
  520. X`09bsbw`09queue_mbxread`09`09; queue another read request
  521. X100$:
  522. X`09ret
  523. X
  524. XQUEUE_MBXREAD:
  525. X`09$qio_s`09efn=#2, func=#io$_readvblk, chan=mbxchan, iosb=mbxiosb,-
  526. X`09`09astadr=mbxread,-
  527. X`09`09p1=mbxbuf, p2=#mbxbuf_siz
  528. X`09blbc`09r0, 100$
  529. X`09rsb
  530. X100$:
  531. X`09bsbw`09error
  532. X`09rsb
  533. X
  534. XTTWRITE::
  535. X;+
  536. X;`09bsbw`09ttwrite
  537. X;`09r3 contains length of buffer to write
  538. X;`09the buffer is outbuf
  539. X;-
  540. X`09movl`09r3, outbuf_qio+qio$_p2`09`09; store length of buffer
  541. X`09$qiow_g`09outbuf_qio
  542. X`09blbc`09r0, 100$
  543. X`09rsb
  544. X100$:
  545. X`09bsbw`09error
  546. X`09rsb
  547. X
  548. X
  549. X`09.entry`09-
  550. Xsnake_screen, `5Em<r2,r3,r4,r5>
  551. X;+
  552. X;`09CALL SNAKE_SCREEN( array, length )
  553. X;`09BYTE ARRAY( LENGTH )
  554. X;`09copies string to update screen into shared memory
  555. X;-
  556. X`09movl`09@8(ap), r0`09`09; get length
  557. X`09movl`09r0, screen_len`09`09; store length
  558. X`09movc3`09r0, @4(ap), screen_buf`09; copy text
  559. X`09ret
  560. X
  561. X`09.entry`09-
  562. Xsnake_write, `5Em<>
  563. X;+
  564. X;`09CALL SNAKE_WRITE( array, length )
  565. X;`09BYTE ARRAY( LENGTH )
  566. X;`09writes buffer to terminal in noformat mode
  567. X;-
  568. X`09movl`094(ap), output_qio+qio$_p1`09; store address of buffer
  569. X`09movl`09@8(ap), output_qio+qio$_p2`09; store length of buffer
  570. X`09$qiow_g`09output_qio
  571. X`09blbc`09r0, 100$
  572. X`09ret
  573. X100$:
  574. X`09bsbw`09error
  575. X`09ret
  576. X
  577. X`09.entry`09-
  578. Xsnake_dead, `5Em<>
  579. X;+
  580. X;`09CALL SNAKE_DEAD( player # )
  581. X;-
  582. X`09subl3`09#1, @4(ap), r0`09`09`09; get # of snake who died
  583. X`09bbss`09r0, you_just_died, 100$`09`09; set flag saying he died
  584. X100$:`09ret
  585. X
  586. X
  587. X`09.entry -
  588. XCANCELTYPEAHEAD, `5Em<>
  589. X`09clrl`09r0
  590. X`09tstw`09ttchan`09`09; check channel is open
  591. X`09beql`09100$
  592. X`09$qiow_s`09func=#io$_readvblk!io$m_purge!io$m_timed,-
  593. X`09`09chan=ttchan, p1=ttbuf`09; do read with 0 length buffer (p2)
  594. X100$:`09ret`09`09`09; return with status in r0
  595. X
  596. XERROR:
  597. X`09blbs`09r0, 100$
  598. X`09pushl`09r0
  599. X`09calls`09#1, G`5Elib$signal
  600. X100$:
  601. X`09rsb
  602. X
  603. X`09.entry`09-
  604. Xcontrol_c, `5Em<>
  605. X`09movb`09#1, control_c_flag
  606. X`09ret
  607. X
  608. X
  609. X`09.page
  610. X`09.entry`09-
  611. XSNAKE_INIT, `5Em<r2,r3,r4,r5>`09`09`09`09; snake game
  612. X;+
  613. X;`09I = SNAKE_INIT( player # , game )
  614. X;`09returns I = 1 if you are master snake.
  615. X;`09returns your player # as a integer
  616. X;`09returns game = 1 if there is a game in progress
  617. X;-
  618. X
  619. X`09calls`09#0, G`5Ettinit`09`09`09; open terminal
  620. X;
  621. X`09$ascefc_s efn=#64, name=snake_desc_2`09; associate event flag cluster
  622. X`09bsbw`09error
  623. X;
  624. X;`09$open`09fab=snake_fab`09`09`09; open section file
  625. X;`09bsbw`09error
  626. X
  627. X`09$deltva_s inadr=map_range`09`09; delete memory were global
  628. X`09bsbw`09error`09`09`09`09;  memory will be mapped
  629. X
  630. X`09$crmpsc_s inadr=map_range, flags=#sec$m_gbl!sec$m_wrt!sec$m_pagfil, -
  631. X`09`09gsdnam=snake_map_name, -`09; chan=snake_fab+fab$l_stv,-
  632. X`09`09pagcnt=#4
  633. X`09bsbw`09error
  634. X
  635. X`09cmpl`09r0, #ss$_created`09`09; are we first to map section
  636. X`09bneq`0950$`09`09`09`09; no
  637. X`09movab`09share_data+4, r3
  638. X`09movc5`09#0, (r3), #0, #512-4, (r3)`09; clear everything except count
  639. X`09$clref_s efn=#flag$v_game+64`09`09; say not game
  640. X`09movl`09#39814571, seed`09`09`09; init random n.g. seed
  641. X`09movl`09#snake, r0`09`09`09; 8 snakes
  642. X20$:
  643. X`09movl`09r0, start_position-4`5Br0`5D`09; init start position
  644. X`09sobgtr`09r0, 20$
  645. X50$:
  646. X`09blbc`09abort, 60$`09`09`09; if not abort --> 60$
  647. X`09callg`09text_abort, snake_write
  648. X`09$exit_s #1
  649. X60$:
  650. X`09bsbw`09queue_mbxread`09`09`09; start terminal read
  651. X;
  652. X`09bbss`09#0, master_flag, 100$`09`09; see if a master snake exists
  653. X`09`09`09; this should be interlocked on a multi-processor
  654. X;+
  655. X; We will have to be the master snake
  656. X;-
  657. X`09movb`09#1, master`09`09`09; indicate we are master snake
  658. X`09$setef_s efn=#7`09`09`09`09; set for first call
  659. X100$:
  660. X;
  661. X`09clrl`09r1`09`09`09`09; start at player 0 (bit0=1)
  662. X150$:
  663. X`09bbcs`09r1, players, 200$`09`09; see if this snake is free
  664. X`09incl`09r1`09`09`09`09; go to next snake
  665. X`09cmpl`09r1, #snake`09`09`09; have we checked all snakes?
  666. X`09blss`09150$`09`09`09`09; no --> 150$
  667. X`09mnegl`09#1, r1`09`09`09`09; player = -1 means none
  668. X200$:
  669. X`09movl`09r1, player`09`09`09; store my snake number (0-7)
  670. X`09movl`09player, @4(ap)`09`09`09;  and return it
  671. X500$:
  672. X`09movzbl`09game_going, @8(ap)`09`09; return game going flag
  673. X
  674. X`09movl`09r1, r3
  675. X`09$getjpi_s itmlst=username_jpi`09`09; get our username
  676. X`09mull2`09#name_size, r3`09`09`09; get offset to start of name
  677. X`09blss`09600$`09`09`09`09; no snakes available
  678. X`09movc5`09username_siz, username_buf, #`5Ea/ /, #name_size, name(r3)
  679. X`09`09`09`09`09`09; copy username
  680. X600$:
  681. X`09$dclexh_s desblk=exit_block`09`09; declare exit handler
  682. X`09bsbw`09error
  683. X
  684. X`09movzbl`09master, r0`09`09`09; return master snake status
  685. X`09ret
  686. X
  687. Xmaster_wait:
  688. X;+
  689. X; master snake has to wait some time for other snakes to start playing
  690. X; called from SNAKE_START
  691. X;-
  692. X`09incl`09game_count`09`09`09; say another game being played
  693. X220$:`09clrb`09player_bits`09`09`09; no other players
  694. X`09bbss`09player, player_bits, 400$`09; say I am playing
  695. X400$:
  696. X`09$clref_s efn=#flag$v_synch+64
  697. X;+
  698. X;`09randomise starting positions
  699. X;-
  700. X`09moval`09start_position, r4`09`09; starting position numbers
  701. X`09movl`09#1, r2`09`09`09`09; snake index (start at 1)
  702. X500$:
  703. X`09pushal`09seed`09`09`09`09; random number seed
  704. X`09calls`09#1, G`5Emth$random`09`09; random real in r0
  705. X`09addl3`09#1, r2, r3`09`09`09; snake + 1
  706. X`09cvtlf`09r3, r3`09`09`09`09; as real
  707. X`09mulf2`09r3, r0`09`09`09`09; get snake to change pos with
  708. X`09cvtfl`09r0, r0
  709. X`09movl`09(r4)`5Br0`5D, r1`09`09`09; swap these positions
  710. X`09movl`09(r4)`5Br2`5D, (r4)`5Br0`5D
  711. X`09movl`09r1, (r4)`5Br2`5D
  712. X`09aobleq`09#7, r2, 500$
  713. X;
  714. X;`09moval`09start_position, r4
  715. X`09movab`09move, r3
  716. X`09movl`09#snake, r2`09`09`09; number of snakes
  717. X600$:
  718. X`09movl`09(r4)+, r0`09`09`09; get start position (1-8)
  719. X`09movb`09start_direction-1`5Br0`5D, (r3)+`09; copy start direction
  720. X`09sobgtr`09r2, 600$
  721. X;
  722. X`09$setimr_s efn=#flag$v_game+64,-`20
  723. X`09`09`09daytim=second_1`09`09; wait a time for other snakes
  724. X`09$waitfr_s efn=#flag$v_game+64`09`09; say that a game is going
  725. X`09movb`09#1, game_going`09`09`09; say game going
  726. X`09$clref_s efn=#flag$v_endofgame+64`09; say not end of game
  727. X`09$setef_s efn=#7`09`09`09`09; sets event flag for first
  728. X`09`09`09`09`09`09;  call to snake_wait
  729. X`09$setimr_s efn=#flag$v_synch+64,-`09`09
  730. X`09`09`09 daytim=start_wait
  731. X`09$waitfr_s efn=#flag$v_synch+64
  732. X`09; this allows other snakes to set bit saying they are playing
  733. X
  734. X`09rsb
  735. X
  736. X`09.entry`09-
  737. XSNAKE_START, `5Em<r2,r3,r4>
  738. X;+
  739. X;`09CALL SNAKE_START( PLAYERS , START_POSITION )
  740. X;`09INTEGER PLAYERS, START_POSITION(8)
  741. X;`09waits 5? seconds for other players to run game
  742. X;`09The master snake is assumed to have waited some additional time
  743. X;`09Returns PLAYERS, bit I <> 0 if that player is active
  744. X;`09START_POSITION(I) is the starting location of snake I, (1-8)
  745. X;-
  746. X`09blbc`09master, 500$`09`09`09; are we master snake ?
  747. X`09bsbw`09master_wait
  748. X`09brb`09800$
  749. X200$:
  750. X`09$exit_s #1`09`09`09`09; game aborted so stop
  751. X500$:
  752. X`09$waitfr_s efn=#flag$v_game+64`09`09; wait until a game starts
  753. X`09blbs`09abort, 200$`09`09`09; if game stopped --> 200$
  754. X`09bbss`09player, player_bits, 600$`09; say I am playing
  755. X600$:`09$waitfr_s efn=#flag$v_synch+64`09`09; synchronise
  756. X`09blbs`09abort, 200$`09`09`09; if game stopped --> 200$
  757. X800$:
  758. X`09movzbl`09player_bits, r4`09`09`09; get player bits
  759. X`09ashl`09#flag$v_done, r4, other_players ; used by master snake
  760. X`09movl`09r4, @4(ap)`09`09`09; store player bits
  761. X`09clrl`09chars_left`09`09`09; cancel type ahead
  762. X`09clrb`09data_ready`09`09`09; make us do a read
  763. X`09$qiow_g read_qio`09`09`09; clear out type-ahead
  764. X;`09return starting positions
  765. X`09moval`09start_position, r0`09`09; address of new positions
  766. X`09movl`098(ap), r2`09`09`09; address of where to put them
  767. X`09movl`09#snake, r1`09`09`09; number of snakes
  768. X900$:
  769. X`09movl`09(r0)+, (r2)+
  770. X`09sobgtr`09r1, 900$
  771. X
  772. X`09mnegl`09#1, last_move_count`09`09; invalidate last counter
  773. X
  774. X`09ret
  775. X
  776. X
  777. XSNAKE_WAIT::
  778. X;+
  779. X;`09BSBW SNAKE_WAIT
  780. X; `09wait until we are told to read players command(s)
  781. X;-
  782. X`09blbs`09master, 200$`09`09`09; are we master snake ?
  783. X`09$waitfr_s efn=#flag$v_read+64`09`09; if not then wait for flag
  784. X`09rsb
  785. X200$:`09; master snake waits and then sets flag for all players
  786. X`09$cantim_s reqidt=#check_timer`09`09; cancel checking timer
  787. X`09$waitfr_s efn=#7`09`09`09; wait for previous timer
  788. X`09$setimr_s efn=#8, daytim=check_wait, -
  789. X`09`09astadr=check_ast, reqidt=#check_timer ; set off checking timer
  790. X`09$setimr_s efn=#7, daytim=update_wait
  791. X`09$clref_s efn=#flag$v_update+64`09`09; clear next flag to wait on
  792. X`09movl`09#flag$v_done+64, r2`09`09; clear each players done flag
  793. X`09$clref_s efn=r2`09`09`09`09; player 0
  794. X`09incl`09r2
  795. X`09$clref_s efn=r2
  796. X`09incl`09r2
  797. X`09$clref_s efn=r2
  798. X`09incl`09r2
  799. X`09$clref_s efn=r2
  800. X`09incl`09r2
  801. X`09$clref_s efn=r2
  802. X`09incl`09r2
  803. X`09$clref_s efn=r2
  804. X`09incl`09r2
  805. X`09$clref_s efn=r2
  806. X`09incl`09r2
  807. X`09$clref_s efn=r2`09`09`09`09; player 7
  808. X;
  809. X`09$clref_s efn=#flag$v_synch+64
  810. X`09$setef_s efn=#flag$v_read+64`09`09; tell everybody to do read
  811. X`09rsb
  812. X
  813. X
  814. XSNAKE_READ::
  815. X;+
  816. X;`09BSBW SNAKE_READ
  817. X;`09read all users moves and store them into the byte array MOVES(*)
  818. X;-
  819. X`09bsbw`09ttread`09`09`09`09; read users commands, if any
  820. X`09tstb`09r0`09`09`09`09; anything read ?
  821. X`09blss`09800$`09`09`09`09; no
  822. X500$:
  823. X`09movl`09player, r1`09`09`09; get our player number
  824. X`09movb`09r0, move(r1)`09`09`09; store our move
  825. X`09bneq`09800$`09`09`09`09; if not quit --> 800$
  826. X`09clrl`09score`5Br1`5D`09`09`09; clear score
  827. X`09clrl`09n_games`5Br1`5D
  828. X`09clrl`09wins`5Br1`5D
  829. X`09$exit_s #1`09`09`09`09; and exit program
  830. X800$:
  831. X`09addl3`09#flag$v_done+64, player, r1
  832. X`09$setef_s efn=r1`09`09`09`09; say that read is complete
  833. X900$:
  834. X`09blbc`09master, 1000$
  835. X`09$wfland_s efn=#64, mask=other_players`09; wait for all players to read
  836. X`09incl`09move_count`09`09`09; onto next move
  837. X`09$clref_s efn=#flag$v_read+64`09`09; clear next flag to wait on
  838. X`09$setef_s efn=#flag$v_update+64`09`09; tell everybody to update
  839. X`09brb`091050$
  840. X1000$:
  841. X`09$waitfr_s efn=#flag$v_update+64`09`09; wait for all reads to complete
  842. X`09blbs`09master_flag, 1050$`09`09; check for master snake OK
  843. X`09movl`09player, r1`09`09`09; get our player number
  844. X`09clrb`09move(r1)`09`09`09; store our move ( quit )
  845. X1050$:
  846. X`09rsb
  847. X
  848. X
  849. X`09.entry`09-
  850. XSNAKE_PLAY, `5Em<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
  851. X;+
  852. X;`09called once at the start of the game.
  853. X;`09I then call the Pascal routine ADD_HEAD to perform the moves.
  854. X;-
  855. X`09blbs`09master, 1000$`09`09; master snake does all the work
  856. X100$:
  857. X`09bsbw`09snake_wait
  858. X`09bsbw`09snake_read
  859. X`09$waitfr_s efn=#flag$v_synch+64`09; wait until screen update there
  860. X`09bsbw`09snake_update`09`09; update screen
  861. X`09brb`09100$
  862. X
  863. X900$:
  864. X`09clrb`09game_going`09`09; tell other snakes games finished
  865. X`09$setef_s efn=#flag$v_synch+64`09; wake other snakes up
  866. X`09bsbb`09snake_update`09`09; write out last move
  867. X`09ret
  868. X
  869. X1000$:`09; master snake moves every snake
  870. X`09bsbw`09snake_wait
  871. X`09bsbw`09snake_read
  872. X`09callg`09add_head_par, G`5Eadd_head`09; call Pascal routine
  873. X`09`09`09`09`09`09; returns 1 if game still going
  874. X`09blbc`09r0, 900$`09`09; game has ended --> 900$
  875. X`09$setef_s efn=#flag$v_synch+64`09; wake other snakes up
  876. X`09bsbb`09snake_update`09`09; update our screen
  877. X`09brb`091000$
  878. X
  879. X
  880. X`09.enable local_block
  881. X500$:
  882. X`09$exit_s #1`09`09`09; game aborted, so exit image
  883. X
  884. Xsnake_update::
  885. X`09blbs`09abort, 500$
  886. X`09blbs`09dead, 80$`09`09; if we are dead, then no head
  887. X;`09replace your snake head with a diamond symbol
  888. X`09movc3`09screen_len, screen_buf, outbuf`09; copy update string
  889. X`09movl`09player, r2`09`09; get my snake number
  890. X`09addw2`09#`5EA/1/+`5EX80, r2`09`09; get number with parity bit set
  891. X`09locc`09r2, screen_len, outbuf
  892. X`09beql`0950$`09`09`09; could not find it !!!
  893. X`09movb`09#`5EA/`60/, (r1)`09`09; change to diamond
  894. X50$:
  895. X`09callg`09update_par, snake_write
  896. X`09blbc`09game_going, 100$`09; bit clear if game has finished
  897. X`09bbsc`09player, you_just_died, 60$ ; see if we just died
  898. X`09rsb
  899. X60$:`09movb`09#1, dead`09`09; say we are dead
  900. X`09callg`09text_wait, snake_write`09; tell them to wait for next game_exit,
  901. X`09rsb
  902. X80$:`09; dont copy buffer if no head to update because we are dead
  903. X`09callg`09update_par2, snake_write
  904. X`09blbc`09game_going, 100$
  905. X`09rsb
  906. X100$:
  907. X`09$setimr_s efn=#6, daytim=second_1`09; so we can see last move
  908. X`09$waitfr_s efn=#6
  909. X`09ret`09`09`09`09; return from SNAKE_PLAY if end game
  910. X`09.disable local_block
  911. X
  912. X
  913. X`09.entry`09-
  914. XCHECK_AST, `5Em<r2,r3,r4>
  915. X;+
  916. X;`09called when check_timer expires (2 seconds)
  917. X;`09we should only get here if one of the other snakes has aborted
  918. X;`09or `5ES ed  .  Force the snake out of the game.
  919. X;-
  920. X`09$readef_s efn=#64, state=cluster_2`09; get done flags
  921. X`09extzv`09#flag$v_done, #snake, cluster_2, r2 ; get done flags
  922. X;`09movb`09other_players+1, r3`09`09; get other players
  923. X`09bicw3`09r2, other_players+1, r3`09`09; find players who have not
  924. X`09`09`09`09`09`09; responded
  925. X`09bicw2`09r3, other_players+1`09`09; and say they are dead
  926. X`09clrl`09r2`09`09`09`09; snake 0
  927. X100$:`09bbc`09r2, r3, 200$
  928. X`09clrb`09move(r2)`09`09`09; say snake has quitted
  929. X`09addl3`09#flag$v_done+64, r2, r0`09`09; get event flag
  930. X`09$setef_s efn=r0`09`09`09`09; set event flag so I will
  931. X`09`09`09`09`09`09; wake up on return from here
  932. X200$:`09aoblss`09#snake, r2, 100$`09`09; for all 8 snakes
  933. X
  934. X`09ret
  935. X
  936. X
  937. X`09.entry`09-
  938. XSNAKE_GAME_END, `5Em<>
  939. X;+
  940. X;`09synchronizes the end of the game
  941. X;-
  942. X`09clrb`09dead`09`09`09; we are not dead
  943. X`09blbc`09master, 500$`09`09; if not master snake --> 500$
  944. X`09$clref_s efn=#flag$v_game+64`09; say game not in progress
  945. X`09clrb`09game_going`09`09; and again
  946. X`09$setimr_s efn=#flag$v_endofgame+64, daytim=second_2
  947. X`09clrw`09you_just_died`09`09; reset died flags
  948. X500$:
  949. X`09$waitfr_s efn=#flag$v_endofgame+64 ; wait for end of game
  950. X`09blbs`09abort, 800$`09`09; if we should abort --> 800$
  951. X`09ret
  952. X800$:`09; we must abort. Probably because master snake stopped
  953. X`09$exit_s #1
  954. X
  955. X
  956. X`09.entry`09-
  957. XSNAKE_EXIT, `5Em<r2,r3,r4,r5>
  958. X;+
  959. X;`09called as an exit handler
  960. X;-
  961. X`09$cancel_s chan=mbxchan`09`09; cancel mailbox read
  962. X
  963. X`09movl`09player, r3`09`09; get my snake number
  964. X`09blss`0980$`09`09`09; we never were playing
  965. X`09clrb`09move(r3)`09`09; make next move a quit
  966. X`09addl3`09#flag$v_done, r3, r2`09; get done bit
  967. X`09bbcc`09r2, other_players, 50$`09; stop master snake from waiting for me
  968. X50$:`09addl2`09#64, r2`09`09`09; make into event flag
  969. X`09$setef_s efn=r2`09`09`09; say input done
  970. X`09bbcc`09r3, players, 60$`09; say this snake available
  971. X60$:
  972. X`09clrl`09score`5Br3`5D`09`09; zero score
  973. X`09clrl`09n_games`5Br3`5D`09`09; zero # of games played
  974. X80$:
  975. X`09blbc`09master, 100$`09`09; are we master snake ?
  976. X`09movb`09#1, abort`09`09; tell all other snakes to abort
  977. X`09clrb`09master_flag`09`09; say no master snake
  978. X`09$setef_s efn=#flag$v_read+64`09; wake everybody up
  979. X`09$setef_s efn=#flag$v_update+64
  980. X`09$setef_s efn=#flag$v_endofgame+64
  981. X`09$setef_s efn=#flag$v_synch+64
  982. X`09$setef_s efn=#flag$v_game+64`09; for people waiting for a game
  983. X100$:
  984. X;`09clear screen and put out of graphics mode
  985. X`09callg`09text_end_game, snake_write
  986. X`09blbc`09abort, 200$`09`09; game is not being aborted --> 200$
  987. X`09callg`09text_abort, snake_write
  988. X200$:
  989. X`09$deltva_s inadr=ret_range`09; delete global section
  990. X
  991. X;`09$dassgn_s chan=snake_fab+fab$l_stv ; deassign channel
  992. X
  993. X`09ret
  994. X
  995. X`09
  996. X`09.entry`09-
  997. XNAME_SET, `5Em<r2,r3,r4,r5>
  998. X;+
  999. X;`09CALL NAME_SET( name )
  1000. X;`09set this players name
  1001. X;-
  1002. X`09mull3`09#name_size, player, r3`09; get our player number (0-7)
  1003. X`09addl2`09#13, r3`09`09`09; skip username
  1004. X`09movc3`09#name_size-13, @4(ap), name(r3) ; store name in shared memory
  1005. X`09ret
  1006. X
  1007. X`09.entry`09-
  1008. XNAME_GET, `5Em<r2,r3,r4,r5>
  1009. X;+
  1010. X;`09CALL NAME_GET( name , player # )
  1011. X;`09returns the name of specified player (1-8)
  1012. X;-
  1013. X`09subl3`09#1, @8(ap), r1`09`09; get player number (0-7)
  1014. X`09mull2`09#name_size, r1`09`09; offset to this players name
  1015. X`09movc3`09#name_size, name(r1), @4(ap) ; return players name
  1016. X`09ret
  1017. X
  1018. X`09.entry`09-
  1019. XSCORE_SET, `5Em<>
  1020. X;+
  1021. X;`09CALL SCORE_SET( player #, score , # games , # wins )
  1022. X;-
  1023. Xplayer_arg = 4
  1024. Xscore_arg = 8
  1025. Xgames_arg = 12
  1026. Xwins_arg = 16
  1027. X`09subl3`09#1, @player_arg(ap), r1`09`09; get our player # (0-snake)
  1028. X`09movl`09@score_arg(ap), score`5Br1`5D`09; store score
  1029. X`09movl`09@games_arg(ap), n_games`5Br1`5D
  1030. X`09movl`09@wins_arg(ap), wins`5Br1`5D
  1031. X`09ret
  1032. X
  1033. X`09.entry`09-
  1034. XSCORE_GET, `5Em<>
  1035. X;+
  1036. X;`09CALL SCORE_GET( player , score , # games , # wins )
  1037. X;-
  1038. X;player_arg = 4
  1039. X;score_arg = 8
  1040. X;games_arg = 12
  1041. X;wins_arg = 16
  1042. X`09subl3`09#1, @player_arg(ap), r1`09`09; get player # (0-snake)
  1043. X`09movl`09score`5Br1`5D, @score_arg(ap)`09; return score
  1044. X`09movl`09n_games`5Br1`5D, @games_arg(ap)`09; return # of games played
  1045. X`09movl`09wins`5Br1`5D, @wins_arg(ap)`09`09; return # of wins
  1046. X`09ret
  1047. X
  1048. X`09.entry`09-
  1049. Xsnake_game_count, `5Em<>
  1050. X;+
  1051. X;`09CALL SNAKE_GAME_COUNT( # games )
  1052. X;`09returns # of games played (total)
  1053. X;-
  1054. X`09movl`09game_count, @4(ap)
  1055. X`09ret
  1056. X
  1057. X`09.end
  1058. $ CALL UNPACK SNAKE.MAR;27 892300509
  1059. $ create 'f'
  1060. X`1B`5BH`1B`5BJ`1B(B`1B`5B0m
  1061. X`1B`5B1;1H`1B(0lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk   lqqqqqqqqqqqqq O`1B
  1062. V(Bbject `1B(0qqqqqqqqqqqqqk
  1063. X`1B`5B2;1Hx`1B`5B2;39Hx   x`1B`5B2;78Hx`1B`5B3;1Hx      lqq  lk  x lqk  k  x
  1064. V lqq       x   x   T`1B(Bo Be The La
  1065. X`1B`5B3;59Hst Snake Alive     `1B(0x`1B`5B4;1Hx      x    xmk x x mk x lj x
  1066. V         x   x`1B`5B4;78Hx
  1067. X`1B`5B5;1Hx      mqqqkx mkx xqqu twj  tq        x   mqqqqqqqqqqqqqqqqqqqqqqq
  1068. Vqqqqqqqqqqqj
  1069. X`1B`5B6;1Hx          xx  xx x  x xmk  x         x   lqqqqqqqqqqqqq H`1B(Baza
  1070. Vrds `1B(0qqqqqqqqqqqqk
  1071. X`1B`5B7;1Hx      lqqqjx  mj m  x x mk mqqqk     x   x`1B`5B7;78Hx`1B`5B8;1Hx
  1072. V      x    x        x    x    `20
  1073. X`1B`5B8;33Hx     x   x H`1B(Bitting Any Object Will Kill You `1B(0x`1B`5B9;1
  1074. VHx`1B`5B9;39Hx   x`1B`5B9;78Hx
  1075. X`1B`5B10;1Hmqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj   mqqqqqqqqqqqqqqqqqqqqqq
  1076. Vqqqqqqqqqqqqj
  1077. X`1B`5B11;1Hlqqqqqqqqqqq I`1B(Bntroduction `1B(0qqqqqqqqqqqqk   lqqqqqqqqqqqq
  1078. V C`1B(Bontrols `1B(0qqqqqqqqqqqqk
  1079. X`1B`5B12;1Hx`1B`5B12;39Hx   x`1B`5B12;78Hx`1B`5B13;1Hx M`1B(Bulti User Game
  1080. V For Up To 8 Players `1B(0x   x`1B`5B13;58H8 `1B(B-
  1081. X`1B`5B13;61H Up`1B`5B13;78H`1B(0x`1B`5B14;1Hx`1B`5B14;39Hx   x`1B`5B14;78Hx`
  1082. V1B`5B15;1Hmqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq
  1083. X`1B`5B15;39Hj   x    4 `1B(B- Left`1B`5B15;66H6 - Right   `1B(0x`1B`5B16;1Hl
  1084. Vqqqqqqqqqqqqq S`1B(Bymbols `1B(0qqqqqqqqqqq
  1085. X`1B`5B16;35Hqqqqk   x`1B`5B16;78Hx`1B`5B17;1Hx`1B`5B17;39Hx   x`1B`5B17;58H2
  1086. V `1B(B- Down`1B`5B17;78H`1B(0x`1B`5B18;1Hx   Y`1B(Bou -`20
  1087. X`1B`5B18;11H`1B(0`60       O`1B(Bthers - 1..8       `1B(0x   x`1B`5B18;78Hx`
  1088. V1B`5B19;1Hx`1B`5B19;39Hx   x       T`1B(Bype "E"`20
  1089. X`1B`5B19;60Hto Exit Game      `1B(0x`1B`5B20;1Hmqqqqqqqqqqqqqqqqqqqqqqqqqqqq
  1090. Vqqqqqqqqqj   mqqqqqqqqqqqqqqqqqqq
  1091. X`1B`5B20;63Hqqqqqqqqqqqqqqqj`1B`5B21;1Hlqqqqqqqqqqqq M`1B(Bessages `1B(0qqqq
  1092. Vqqqqqqqqqqqk   lqqqqqqqqqqqqq N`1B(Ba
  1093. X`1B`5B21;60Hme `1B(0qqqqqqqqqqqqqqqk`1B`5B22;1Hx`1B`5B22;39Hx   x     `1B(B*
  1094. V`1B(0`7E `1B`5B22;70H`7E*      x
  1095. X`1B`5B23;1Hmqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj   mqqqqqqqqqqqqqqqqqqqqqq
  1096. Vqqqqqqqqqqqqj`1B`5B1;1H
  1097. X`1B*
  1098. $ CALL UNPACK SNAKE.SCN;9 185950272
  1099. $ create 'f'
  1100. X`09SUBROUTINE`09HELP_SCREEN
  1101. XC
  1102. X`09PARAMETER ESC = 27
  1103. X`09CHARACTER Line*256
  1104. X        BYte REP
  1105. X`09INTEGER Len_Line,ErrNum
  1106. XC
  1107. X`09CALL image_dir()
  1108. XC
  1109. X        Write(5,111)esc
  1110. X111     Format(X,A1,'<')
  1111. X1`09OPEN(UNIT=4,FILE='IMAGE_DIR:SNAKE.SCN',ReadOnly,
  1112. X`091 STATUS='OLD',IoStat=ErrNum)
  1113. X        If (ERRNUM.EQ.30) Goto 50
  1114. X        If (ERRNUM.NE.0 ) Goto 999
  1115. X100     READ(4,110,END=200) LEN_LINE, LINE(:LEN_LINE)
  1116. X110     FORMAT(Q,A)
  1117. X        WRITE(5,120) LINE(:LEN_LINE)
  1118. X120     FORMAT(1X,A)
  1119. X        GOTO 100
  1120. X200`09close (unit = 4)
  1121. X999`09RETURN
  1122. XC
  1123. X50`09Write(5,51),Esc,Esc
  1124. X51      FORMAT(X,A1,'`5B2J',A1,'`5B1;1HPlease wait...')
  1125. X        Call Sleep(4)
  1126. X        Goto 1
  1127. XC
  1128. X        END
  1129. $ CALL UNPACK SNAKEH.FOR;2 1311099332
  1130. $ create 'f'
  1131. X
  1132. X`7B$S-`7D
  1133. X`7B$C+`7D
  1134. X`7B
  1135. X
  1136. X                 XXXXX    X     X   XXXXX   X    X  XXXXXX
  1137. X                X     X   XX    X  X     X  X    X  X    `20
  1138. X                X         X X   X  X     X  X   X   X    `20
  1139. X                 XXXXX    X  X  X  XXXXXXX  XXXX    XXXXX`20
  1140. X                      X   X   X X  X     X  X  X    X    `20
  1141. X                X     X   X    XX  X     X  X   X   X    `20
  1142. X                 XXXXX    X     X  X     X  X    X  XXXXXX
  1143. X                                                         `20
  1144. X
  1145. X`09`09Program`09: Snake
  1146. X
  1147. X`09`09Authors`09: Rex Croft       - Macro
  1148. X
  1149. X                          Murray Speight - Pascal`20
  1150. X
  1151. X`09`09Place`09: University Of Waikato`20
  1152. X
  1153. X`09`09Date `09: May 1982`20
  1154. X
  1155. X`09Software Is Subject To Change Without Notification
  1156. X        The Author And His Family assume No Rsponsability For
  1157. X`09Its Reliabliity Or Use.`20
  1158. X
  1159. X         `7D
  1160. X
  1161. XProgram Snake(Input,Output);
  1162. X
  1163. XLabel`099999;  `7B For Abortive exit Of Pgm `7D
  1164. X
  1165. X
  1166. XConst `09Max_Num_Players`09= 8;             `7B Up To 8 Players `7D
  1167. X`09Screen_Dim_X `09= 23;            `7B PLaying Board 40 * 23 `7D
  1168. X`09Screen_Dim_Y`09= 40;
  1169. X`09Len_Of_Buff`09= 1024;          `7B Buffer to Write Chars `7D
  1170. X        Max_Name_Length = 32;            `7B Lenngth of a players name `7D
  1171. X
  1172. XType `09Player_Responce = Packed Array `5B1..Max_Num_Players`5D Of Char;
  1173. X`09Buffer`09`09= Packed Array `5B1..Len_Of_Buff`5D Of Char;`09
  1174. X`09Positions`09= Array `5B1..Max_Num_Players`5D Of INteger;
  1175. X`09Players_Screen`09= Array `5B1..Screen_Dim_X,1..Screen_Dim_Y`5D Of Char;
  1176. X`09Died_Type`09= Array `5B1..Max_NUm_Players`5D Of Boolean;
  1177. X`09Name_Line`09= Packed array `5B1..max_Name_Length`5D of Char;
  1178. X        Name_Table`09= Array `5B1..Max_Num_Players`5D of name_LIne;
  1179. X
  1180. XVar `09Responce `09,`09`09`09`7B What Players Have Typed `7D
  1181. X`09Head_Sym`09: Player_Responce;      `7B What Symbol is THe Head `7D
  1182. X`09Screen`09`09: Players_Screen;       `7B 23 * 40 Array For Screen`7D
  1183. X`09Name`09`09: Name_Table;           `7B Names Of Each Player `7D
  1184. X        Init_Pos_X`09,                       `7B Where initaially Players St
  1185. Vart `7D
  1186. X        Init_pos_Y      ,                       `7B  "" "" For Y Coord `7D
  1187. X`09Score`09`09,                       `7B Score Of Each PLayer `7D
  1188. X        Game`09`09,                       `7B Num Games Each PLayer Played `
  1189. V7D
  1190. X`09Games_Won `09,                       `7B Games Won By Each PLayer `7D
  1191. X`09Move_X`09`09,                       `7B What Dir Each Playe Is Moving X C
  1192. Voord `7D
  1193. X`09Move_Y`09`09,                       `7B "" "" Y Coord `7D
  1194. X`09Head_X`09`09,                       `7B Where The Head Is For Each Player
  1195. V X Coord `7D
  1196. X`09Head_Y`09 `09,                       `7B "" "" Y Coord `7D
  1197. X`09Tail_X`09`09,                       `7B Where The Tail Is For Each Player
  1198. V X Coord `7D
  1199. X`09Tail_Y`09`09: Positions;            `7B "" "" Y Cord `7D
  1200. X`09TT_Buff`09`09: Buffer;               `7B Lenght Of Buffer To Hold Screen
  1201. V Output `7D
  1202. X`09TT_Len`09`09,                       `7B String To Hold Screen Output `7D
  1203. X        Who_Is_PLaying  ,                       `7B Word With Bits Set As To
  1204. V Who is Playing `7D
  1205. X`09You`09`09,                       `7B Which Number You are `7D`20
  1206. X`09Dummy `09`09,                       `7B Dummy argument `7D
  1207. X`09Num_players     ,                       `7B How Many people are Playing `
  1208. V7D
  1209. X`09Max_Player_Number ,                     `7B The Highest PLayers Number wh
  1210. Vo is Playing `7D
  1211. X        Num_Moved_Last_Round    ,               `7B Number of players who mo
  1212. Vved last Round ( Last Screen Update ) `7D
  1213. X`09Players_Removing`09: Integer;      `7B Are We Removing Odd 1 or even 2 pl
  1214. Vayers Tails `7D
  1215. X`09Quit`09`09,                       `7B Has The PLayer Quit (not playing )
  1216. V or is He Playing `7D
  1217. X`09Died `09`09: Died_Type;            `7B Has The PLayer Died ( Died If He h
  1218. Vas Quit ) `7D
  1219. X`09Esc`09`09: Char;                 `7B esc For escape sequences `7D
  1220. X`09Seed`09`09: Real;                 `7B Seed for random number generaotor `
  1221. V7D
  1222. X
  1223. X
  1224. XProcedure Break_Buff;
  1225. X
  1226. X   Procedure Snake_Screen( Var Line : Buffer ; Var Lenght : Integer );extern
  1227. V;`20
  1228. X
  1229. X`7B Only Call This Once From The Add_head Function`20
  1230. X
  1231. X   Does not write array to screen `7D
  1232. X
  1233. XBegin
  1234. X   Snake_Screen(TT_Buff,TT_Len);`20
  1235. X   TT_Len := 0;
  1236. Xend;
  1237. X
  1238. X
  1239. XProcedure Help_Screen;extern;
  1240. X
  1241. XProcedure Pos( X,Y : Integer ; Ch : Char );
  1242. X
  1243. X`7B Write Char at Pos X,Y in Buffer `7D
  1244. X
  1245. XBegin
  1246. X   TT_Buff`5BTT_Len+1`5D := Esc;
  1247. X   TT_Buff`5BTT_Len+2`5D := 'Y';
  1248. X   TT_Buff`5BTT_Len+3`5D := Chr(31+X);
  1249. X   TT_Buff`5BTT_Len+4`5D := Chr(31+Y);
  1250. X   TT_Buff`5BTT_Len+5`5D := Ch;
  1251. X   TT_Len := TT_Len + 5;
  1252. Xend;
  1253. X
  1254. XFunction at(X,Y: Integer):Char;
  1255. X
  1256. X`7B Posotion Cursor at X , Y this Is For Use In Write Statments `7D
  1257. X
  1258. XBegin
  1259. +-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-
  1260.